home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / extend / tests / help.test < prev    next >
Encoding:
Text File  |  1993-10-26  |  6.4 KB  |  239 lines  |  [TEXT/MPS ]
  1. #
  2. # help.test
  3. #
  4. # Tests for the help subsystem.  Help must be build first.  If help files
  5. # change, thest tests may have to be changed.
  6. #---------------------------------------------------------------------------
  7. # Copyright 1992-1993 Karl Lehenbauer and Mark Diekhans.
  8. #
  9. # Permission to use, copy, modify, and distribute this software and its
  10. # documentation for any purpose and without fee is hereby granted, provided
  11. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  12. # Mark Diekhans make no representations about the suitability of this
  13. # software for any purpose.  It is provided "as is" without express or
  14. # implied warranty.
  15. #------------------------------------------------------------------------------
  16. # $Id: help.test,v 2.7 1993/07/20 08:35:45 markd Exp $
  17. #------------------------------------------------------------------------------
  18. #
  19.  
  20. if {[info procs test] != "test"} then {source testlib.tcl}
  21.  
  22. #
  23. # Only run help test if help has been installed.
  24. #
  25. if {"[glob -nocomplain ../tclmaster/help/*]" == ""} {
  26.     echo "****"
  27.     echo "**** No help pages in tclmaster/help - help test not run"
  28.     echo "****"
  29.     return
  30. }
  31.  
  32. #------------------------------------------------------------------------------
  33. # Read a line from the server, set an alarm to make sure it doesn't hang.
  34. proc ReadServer {} {
  35.     global G_helpOutPipeFH
  36.  
  37.     alarm 45
  38.     if {[gets $G_helpOutPipeFH line] < 0} {
  39.         alarm 0
  40.         error "EOF from help server"}
  41.     alarm 0
  42.     return $line
  43. }
  44.  
  45. #------------------------------------------------------------------------------
  46. # Eat a prompt line from the help server.
  47.  
  48. proc EatServerPrompt {} {
  49.     set line [ReadServer]
  50.     if {"$line" != "===HELPSERVER==="} {
  51.         error "unexpected output from help server: `$line'"}
  52. }
  53.  
  54. #------------------------------------------------------------------------------
  55. # Send a command to the help server and return the output.  The help server
  56. # output will be bracketed with commands to mark the beginning and ending.
  57. # An extra newline is always queued to continue the help pager.  The prompt of
  58. # the pager will be removed from the output.  This assumes that the output has
  59. # no lines starting with `:'.
  60. #
  61. proc HelpSend {cmd pagerCntVar} {
  62.     global G_helpInPipeFH G_helpOutPipeFH
  63.     upvar $pagerCntVar pagerCnt
  64.  
  65.     puts $G_helpInPipeFH $cmd
  66.     puts $G_helpInPipeFH ""  ;# Just a new line..
  67.     flush $G_helpInPipeFH
  68.  
  69.     set pagerCnt 0
  70.     set results {}
  71.  
  72.     # Read lines of the output.
  73.     while 1 {
  74.         set line [ReadServer]
  75.         if {"[cindex $line 0]" == ":"} {
  76.             set line [crange $line 1 end]
  77.             incr pagerCnt
  78.             puts $G_helpInPipeFH ""  ;# Just a new line
  79.         }
  80.         if {"$line" == "===HELPSERVER==="} {
  81.             break}
  82.         append results $line "\n"
  83.     }
  84.     # Eat the extra prompt caused by the typed-ahead newline
  85.     EatServerPrompt
  86.  
  87.     return $results
  88. }
  89. #
  90. # Create the help server process, which will execute the commands, 
  91. # with stdin and stdout redirected to pipes.
  92. #
  93.  
  94. global G_helpInPipeFH G_helpOutPipeFH G_helpPid
  95.  
  96. pipe fromClientPipeFH G_helpInPipeFH
  97. pipe G_helpOutPipeFH  toClientPipeFH
  98.  
  99. fcntl $G_helpInPipeFH  NOBUF 1
  100. fcntl $G_helpOutPipeFH NOBUF 1
  101.  
  102. flush stdout  ;# Not going to exec, must clean up the buffers.
  103. flush stderr
  104. set G_helpPid [fork]
  105.  
  106. if {$G_helpPid == 0} {
  107.     close stdin
  108.     dup $fromClientPipeFH stdin
  109.     close stdout
  110.     dup $toClientPipeFH stdout
  111.     close $G_helpInPipeFH
  112.     close $G_helpOutPipeFH
  113.  
  114.     eval $SAVED_UNKNOWN
  115.  
  116.     commandloop {puts stdout "===HELPSERVER==="; flush stdout} \
  117.                 {error "Help server incomplete cmd"}
  118.     error "Help server got eof"
  119. }
  120.  
  121. close $fromClientPipeFH
  122. close $toClientPipeFH
  123.  
  124. #
  125. # An alarm will be set when talking to the server uncase it doesn't talk back
  126. #
  127. signal error SIGALRM
  128.  
  129. # Nuke the first prompt
  130. EatServerPrompt
  131.  
  132. # Now run the tests.
  133.  
  134.  
  135. Test help-1.1 {help tests} {
  136.     HelpSend "help" promptCnt
  137. } 0 {
  138. Subjects available in /:
  139.    tcl/
  140.  
  141. Help pages available in /:
  142.    help
  143. }
  144.  
  145. Test help-1.1.1 {help tests} {
  146.     HelpSend "help tcl" promptCnt
  147. } 0 {
  148. Subjects available in /tcl:
  149.    control/         debug/           files/           filescan/
  150.    internation/     intro/           keyedlists/      libraries/
  151.    lists/           math/            processes/       signals/
  152.    status/          strings/         tclshell/        time/
  153.    variables/
  154. }
  155.  
  156. Test help-1.2 {help tests} {
  157.     HelpSend "helppwd" promptCnt
  158. } 0 {Current help subject: /
  159. }
  160.  
  161. Test help-1.3 {help tests} {
  162.     HelpSend "helpcd tcl/filescan" promptCnt
  163. } 0 {}
  164.  
  165. Test help-1.4 {help tests} {
  166.     HelpSend "helppwd" promptCnt
  167. } 0 {Current help subject: /tcl/filescan
  168. }
  169.  
  170. Test help-1.5 {help tests} {
  171.     set result [HelpSend "help /tcl/lists/lassign" promptCnt]
  172.     set fh [open "../tclmaster/help/tcl/lists/lassign"]
  173.     set expect [read $fh]
  174.     close $fh
  175.     set summary {}
  176.     if {"$expect" == "$result"} {
  177.         append summary "CORRECT"
  178.     } else {
  179.         append summary "DATA DOES NOT MATCH : $result"
  180.     }
  181.     if {$promptCnt == 0} {
  182.        append summary " : PROMPT OK"
  183.     } else {
  184.        append summary " : TOO MANY PROMPTS: $promptCnt"
  185.     }
  186.     set summary
  187. } 0 {CORRECT : PROMPT OK}
  188.  
  189. Test help-1.6 {help tests} {
  190.     set result [HelpSend "help /tcl/math/expr" promptCnt]
  191.     set fh [open "../tclmaster/help/tcl/math/expr"]
  192.     set expect [read $fh]
  193.     close $fh
  194.     set summary {}
  195.     if {"$expect" == "$result"} {
  196.         append summary "CORRECT"
  197.     } else {
  198.         append summary "DATA DOES NOT MATCH: $result"
  199.     }
  200.     if {$promptCnt >= 2} {
  201.        append summary " : PROMPT OK"
  202.     } else {
  203.        append summary " : NOT ENOUGH PROMPTS: $promptCnt"
  204.     }
  205.     set summary
  206. } 0 {CORRECT : PROMPT OK}
  207.  
  208. Test help-1.7 {help tests} {
  209.     HelpSend "apropos upvar" promptCnt
  210. } 0 {tcl/variables/upvar - Create link to variable in a different stack frame
  211. }
  212.  
  213. Test help-1.8 {help tests} {
  214.     HelpSend "apropos clock" promptCnt
  215. } 0 {tcl/time/alarm - Set a process alarm clock.
  216. tcl/time/convertclock - Parse and convert a date and time string to integer clock value.
  217. tcl/time/fmtclock - Convert an integer time value to human-readable format.
  218. tcl/time/getclock - Return current date and time as an integer value.
  219. }
  220.  
  221. Test help-1.9 {help tests} {
  222.     HelpSend "helpcd" promptCnt
  223. } 0 {}
  224.  
  225. Test help-1.10 {help tests} {
  226.     HelpSend "helppwd" promptCnt
  227. } 0 {Current help subject: /
  228. }
  229.  
  230.  
  231. # Terminate the help server.
  232.  
  233. puts $G_helpInPipeFH "exit 0"
  234. set status [wait $G_helpPid]
  235. if {"$status" != "$G_helpPid EXIT 0"} {
  236.     error "Bad status returned: `$status'"}
  237.  
  238. return
  239.